home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Environments / Open Prolog 1.0.3d33 / Contributions from Others / Viren Patel / eliza next >
Text File  |  1993-05-19  |  29KB  |  896 lines
  1. /*****************************************************************************/
  2. /* ELIZA in Prolog                                                           */
  3. /*                                                                           */
  4. /*    Viren Patel                                                            */
  5. /*    Artificial Intelligence Programs                                       */
  6. /*    University of Georgia, Athens, Georgia                                 */
  7. /*    Email: vpatel@aisun1.ai.uga.edu                                        */
  8. /*                                                                           */
  9. /* Reference                                                                 */
  10. /*                                                                           */
  11. /*    Weizenbaum, J., (1966) ELIZA - A computer program for the study of     */
  12. /*    natural language communication between man and machine. Communications */
  13. /*    of the ACM, 9.1:36-45.                                                 */
  14. /*                                                                           */
  15. /* Acknowledgments                                                           */
  16. /*                                                                           */
  17. /*    read_atomics/1 and suporting clauses are courtesy of Dr. Michael A.    */
  18. /*    Covington, AI Programs, University of Georgia, Athens, Georgia from    */
  19. /*    his forthcoming book, Natural language processing for Prolog           */
  20. /*    programmers.                                                           */
  21. /*                                                                           */
  22. /*    match/2 and its supporting clauses make up the pattern matcher. The    */
  23. /*    basic code for the pattern matcher was obtained from the book by       */
  24. /*    R. A. O'Keefe, The craft of Prolog.                                    */
  25. /*                                                                           */
  26. /* Requires: Open Prolog 1.0d29 or later                                     */
  27. /*                                                                           */
  28. /* To run:  consult(eliza),eliza.                                            */
  29. /* To stop: > quit. (`>' is the Eliza prompt)                                */
  30. /*                                                                           */
  31. /* Last Revised: April 10, 1992                                              */
  32. /*                                                                           */
  33. /*****************************************************************************/
  34.  
  35. /*****************************************************************************/
  36. /* Modified for Open Prolog by Mike Brady brady@cs.tcd.ie, April 27, 1992    */
  37.  
  38. %  replace retractall/1 by abolish/2
  39. %  remove dynamic definitions
  40. %  replace end of line and end of file markers with 31 and 26 respectively
  41. %  deleted the call to eliza from within the consultation - it looks ugly in Open Prolog.
  42. %  changed the requirements and instruction stuff above as appropriate
  43.  
  44. %Remember to type the ENTER key to enter a line of text, not the RETURN key
  45.  
  46. /*****************************************************************************/
  47. % simplification rules
  48.  
  49. sr([do,not|X],[dont|Y],X,Y).
  50. sr([can,not|X],[cant|Y],X,Y).
  51. sr([cannot|X],[cant|Y],X,Y).
  52. sr([will,not|X],[wont|Y],X,Y).
  53. sr([dreamed|X],[dreamt|Y],X,Y).
  54. sr([dreams|X],[dream|Y],X,Y).
  55. sr([how|X],[what|Y],X,Y).
  56. sr([when|X],[what|Y],X,Y).
  57. sr([alike|X],[dit|Y],X,Y).
  58. sr([same|X],[dit|Y],X,Y).
  59. sr([certainly|X],[yes|Y],X,Y).
  60. sr([maybe|X],[perhaps|Y],X,Y).
  61. sr([deutsch|X],[xfremd|Y],X,Y).
  62. sr([francais|X],[xfremd|Y],X,Y).
  63. sr([espanol|X],[xfremd|Y],X,Y).
  64. sr([machine|X],[computer|Y],X,Y).
  65. sr([machines|X],[computer|Y],X,Y).
  66. sr([computers|X],[computer|Y],X,Y).
  67. sr([am|X],[are|Y],X,Y).
  68. sr([your|X],[my|Y],X,Y).
  69. sr([were|X],[was|Y],X,Y).
  70. sr([me|X],[you|Y],X,Y).
  71. sr([you,are|X],[im|Y],X,Y).      % im = i'm = i am
  72. sr([i,am|X],[youre|Y],X,Y).      % youre = you're = you are =\= your
  73. sr([myself|X],[yourself|Y],X,Y).
  74. sr([yourself|X],[myself|Y],X,Y).
  75. sr([mom|X],[mother|Y],X,Y).
  76. sr([dad|X],[father|Y],X,Y).
  77. sr([i|X],[you|Y],X,Y).
  78. sr([you|X],[i|Y],X,Y).
  79. sr([my|X],[your|Y],X,Y).
  80. sr([everybody|X],[everyone|Y],X,Y).
  81. sr([nobody|X],[everyone|Y],X,Y).
  82.  
  83.  
  84. /*****************************************************************************/
  85. % Make the rule base modifiable
  86. %    this is specific to Quintus Prolog
  87.  
  88. %:- dynamic(rules/1).
  89.  
  90.  
  91. /*****************************************************************************/
  92. % The rule base
  93. %    The format of the rules is:
  94. %
  95. % rules([[keyword, importance of keyword],[
  96. %         [pattern #, [the pattern], last response used,
  97. %             [response 1],
  98. %             [response 2],
  99. %             ...
  100. %             [response n]]]]).
  101.  
  102. rules([[sorry,0],[
  103.     [1,[_],0,
  104.         [please,do,not,apologize,.],
  105.         [apologies,are,not,necessary,.],
  106.         [what,feelings,do,you,have,when,you,apologize,?],
  107.         ['I',have,told,you,that,apologies,are,not,required,.]]]]).
  108.  
  109. rules([[remember,5],[
  110.     [1,[_,you,remember,Y],0,
  111.         [do,you,often,think,of,Y,?],
  112.         [does,thinking,of,Y,bring,anything,else,to,mind,?],
  113.         [what,else,do,you,remember,?],
  114.         [why,do,you,remember,Y,just,now,?],
  115.         [what,in,the,present,situation,reminds,you,of,Y,?],
  116.         [what,is,the,connection,between,me,and,Y,?]],
  117.     [2,[_,do,i,remember,Y],0,
  118.         [did,you,think,'I',would,forget,Y,?],
  119.         [why,do,you,think,i,should,recall,Y,now,?],
  120.         [what,about,Y,?],
  121.         [equal,[what,0]],
  122.         [you,mentioned,Y,.]],
  123.     [3,[_],0,
  124.         [newkey]]]]).
  125.  
  126. rules([[if,3],[
  127.     [1,[_,if,Y],0,
  128.         [do,you,think,it,is,likely,that,Y,?],
  129.         [do,you,wish,that,Y,?],
  130.         [what,do,you,think,about,Y,?],
  131.         [really,',',if,Y,?]]]]).
  132.  
  133. rules([[dreamt,4],[
  134.     [1,[_,you,dreamt,Y],0,
  135.         [really,',',Y,?],
  136.         [have,you,ever,fantasied,Y,while,you,were,awake,?],
  137.         [have,you,dreamt,Y,before,?],
  138.                 [equal,[dream,3]],
  139.         [newkey]]]]).
  140.  
  141. rules([[dream,3],[
  142.     [1,[_],0,
  143.         [what,does,that,dream,suggest,to,you,?],
  144.         [do,you,dream,often,?],
  145.         [what,persons,appear,in,your,dreams,?],
  146.         [do,you,believe,that,dreaming,has,something,to,do,with,your,problem,?],
  147.         [newkey]]]]).
  148.  
  149. rules([[none,0],[
  150.     [1,[_],0,
  151.         ['I',am,not,sure,'I',understand,you,fully,.],
  152.         [please,go,on,.],
  153.         [what,does,that,suggest,to,you,?],
  154.         [do,you,feel,strongly,about,discussing,such,things,?]]]]).
  155.  
  156. rules([[perhaps,0],[
  157.     [1,[_],0,
  158.         [you,do,not,seem,quite,certain,.],
  159.         [why,the,uncertain,tone,?],
  160.         [can,you,not,be,more,positive,?],
  161.         [you,are,not,sure,?],
  162.         [do,you,not,know,?]]]]).
  163.  
  164. rules([[name,15],[
  165.     [1,[_],0,
  166.         ['I',am,not,interested,in,names,.],
  167.         ['I',have,told,you,before,',','I',do,not,care,about,names,.],
  168.         [please,continue,.]]]]).
  169.  
  170. rules([[xfremd,75],[
  171.     [1,[_],0,
  172.         ['I',am,sorry,',','I',only,speak,'English',.]]]]).
  173.  
  174. rules([[hello,0],[
  175.     [1,[_],0,
  176.         [how,do,you,do,'.','Please',state,your,problem,.]]]]).
  177.  
  178. rules([[computer,50],[
  179.     [1,[_],0,
  180.         [do,computers,worry,you,?],
  181.         [why,do,you,mention,computers,?],
  182.         [what,do,you,think,machines,have,to,do,with,your,problem,?],
  183.         [do,you,not,think,computers,can,help,people,?],
  184.         [what,about,machines,worries,you,?],
  185.         [what,do,you,think,about,machines,?]]]]).
  186.  
  187. rules([[are,0],[
  188.     [1,[_,are,you,Y],0,
  189.         [do,you,believe,you,are,Y,?],
  190.         [would,you,want,to,be,Y,?],
  191.         [you,wish,'I',would,tell,you,you,are,Y,?],
  192.                 [what,would,it,mean,if,you,were,Y,?],
  193.         [equal,[what,0]]],
  194.     [2,[_,are,i,Y],0,
  195.         [why,are,you,interested,in,whether,'I',am,Y,or,not,?],
  196.         [would,you,prefer,if,'I',were,not,Y,?],
  197.         [perhaps,'I',am,Y,in,your,fantasies,.],
  198.                 [do,you,sometimes,think,'I',am,Y,?],
  199.         [equal,[what,0]]],
  200.     [3,[_,are,Y],0,
  201.         [did,you,think,they,might,not,be,Y,?],
  202.         [would,you,like,it,if,they,were,not,Y,?],
  203.         [what,if,they,were,not,Y,?],
  204.         [possibly,they,are,Y,.]],
  205.     [4,[_],0,
  206.         [why,do,you,say,am,?],
  207.         ['I',do,not,understand,that,.]]]]).
  208.  
  209.  
  210. rules([[my,0],[
  211.     [1,[_,my,Y],0,
  212.         [why,are,you,concerned,over,my,Y,?],
  213.         [what,about,your,own,Y,?],
  214.         [are,you,worried,about,someone,elses,Y,?],
  215.         [really,',',my,Y,?]]]]).
  216.  
  217. rules([[was,2],[
  218.     [1,[_,was,you,Y],0,
  219.         [what,if,you,were,Y,?],
  220.         [do,you,think,you,were,Y,?],
  221.         [were,you,Y,?],
  222.         [what,would,it,mean,if,you,were,Y,?],
  223.                 [what,does,Y,suggest,to,you,?],
  224.         [equal,[what,0]]],
  225.     [2,[_,you,was,Y],0,
  226.         [were,you,really,?],
  227.         [why,do,you,tell,me,you,were,Y,just,now,?],
  228.         [perhaps,'I',already,knew,you,were,Y,.]],
  229.     [3,[_,was,i,Y],0,
  230.         [would,you,like,to,believe,'I',was,Y,?],
  231.         [what,suggests,that,'I',was,Y,?],
  232.         [what,do,you,think,?],
  233.         [perhaps,'I',was,Y,.],
  234.         [what,if,'I',had,been,Y,?]],
  235.     [4,[_],0,
  236.         [newkey]]]]).
  237.  
  238. rules([[im,0],[
  239.         [1,[_,im,_],0,
  240.         [equal,[i,0]]]]]).
  241.  
  242. rules([[youre,0],[
  243.         [1,[_,youre,_],0,
  244.         [equal,[you,0]]]]]).
  245.  
  246. rules([[you,0],[
  247.     [1,[_,you,cant,Y],0,
  248.         [how,do,you,know,you,can,not,Y,?],
  249.         [have,you,tried,?],
  250.         [perhaps,you,could,Y,now,?],
  251.         [do,you,really,want,to,be,able,to,Y,?]],
  252.     [2,[_,you,dont,Y],0,
  253.         [do,you,not,really,Y,?],
  254.         [why,do,you,not,Y,?],
  255.         [do,you,wish,to,be,able,to,Y,?],
  256.         [does,that,trouble,you,?]],
  257.     [3,[_,you,feel,Y],0,
  258.         [tell,me,more,about,such,feelings,.],
  259.         [do,you,often,feel,Y,?],
  260.         [do,you,enjoy,feeling,Y,?],
  261.         [of,what,does,feeling,Y,remind,you,?]],
  262.         [4,[_,you,was,_],0,
  263.         [equal,[was,2]]],
  264.     [5,[_,you,Y,i,_],0,
  265.         [perhaps,in,your,fantasy,we,Y,each,other,?],
  266.         [do,you,wish,to,Y,me,?],
  267.         [you,seem,to,need,to,Y,me,.],
  268.         [do,you,Y,anyone,else,?]],
  269.     [6,[_,you,[*,want,need,_],Y],0,
  270.         [what,would,it,mean,to,you,if,you,got,Y,?],
  271.         [why,do,you,want,Y,?],
  272.         [suppose,you,got,Y,soon,?],
  273.         [what,if,you,never,got,Y,?],
  274.         [what,would,getting,Y,mean,to,you,?],
  275.         [what,does,wanting,Y,have,to,do,with,this,discussion,?]],
  276.     [7,[_,you,[*,feel,think,believe,wish,_],you,Y],0,
  277.         [do,you,really,think,so,?],
  278.         [but,you,are,not,sure,you,Y,?],
  279.         [do,you,really,doubt,you,Y,?]],
  280.         [8,[_,you,_,[*,feel,think,believe,wish,_],_,i,_],0,
  281.         [equal,[you,0]]],
  282.     [9,[_,youre,_,[*,sad,unhappy,depressed,sick,M],_],0,
  283.         ['I',am,sorry,to,hear,you,are,M,.],
  284.         [do,you,think,coming,here,will,help,you,not,to,be,M,?],
  285.         ['I',am,sure,it,is,not,pleasant,to,be,M,.],
  286.         [can,you,explain,what,made,you,M,?]],
  287.     [10,[_,youre,_,[*,happy,elated,glad,better,M],_],0,
  288.         [how,have,'I',helped,you,to,be,M,?],
  289.         [has,your,treatment,made,you,M,?],
  290.         [what,makes,you,M,just,now,?],
  291.         [can,you,explain,why,you,are,suddenly,M,?]],
  292.     [11,[_,youre,Y],0,
  293.         [is,it,because,you,are,Y,that,you,came,to,me,?],
  294.         [how,long,have,you,been,Y,?],
  295.         [do,you,believe,it,normal,to,be,Y,?],
  296.         [do,you,enjoy,being,Y,?]],
  297.     [12,[X],0,
  298.         [you,say,X],
  299.         [can,you,elaborate,on,that,?],
  300.         [do,you,say,X,for,some,special,reason,?],
  301.         [that,is,quite,interesting,.]]]]).
  302.  
  303. rules([[i,0],[
  304.         [1,[_,i,remind,you,of,_],0,
  305.         [equal,[dit,10]]],
  306.     [2,[_,im,Y],0,
  307.         [what,makes,you,think,'I',am,Y,?],
  308.         [does,it,please,you,to,believe,'I',am,Y,?],
  309.         [do,you,sometimes,wish,you,were,Y,?],
  310.         [perhaps,you,would,like,to,be,Y,?]],
  311.     [3,[_,i,Y,you],0,
  312.         [why,do,you,think,'I',Y,you,?],
  313.         [you,like,to,think,'I',Y,you,',',do,you,not,?],
  314.         [what,makes,you,think,'I',Y,you,?],
  315.         [really,',','I',Y,you,.],
  316.         [do,you,wish,to,believe,'I',Y,you,?],
  317.         [suppose,'I',did,Y,you,',',what,would,that,mean,to,you,?],
  318.         [does,someone,else,believe,'I',Y,you,?]],
  319.     [4,[_,i,Y],0,
  320.         [we,were,discussing,you,',',not,me,.],
  321.         [oh,',',i,Y,.],
  322.         [you,are,not,really,talking,about,me,',',are,you,?],
  323.         [what,are,your,feelings,now,?]]]]).
  324.  
  325. rules([[yes,0],[
  326.     [1,[_],0,
  327.         [you,seem,quite,positive,.],
  328.         [you,are,sure,?],
  329.         [i,see,.],
  330.         [i,understand,.]]]]).
  331.  
  332. rules([[no,0],[
  333.     [1,[_],0,
  334.         [are,you,saying,no,just,to,be,negative,?],
  335.         [you,are,being,a,bit,negative,.],
  336.         [why,not,?],
  337.         [why,no,?]]]]).
  338.  
  339. rules([[your,2],[
  340.     [1,[_,your,_,[*,mother,father,brother,sister,children,wife,M],Z],0,
  341.         [tell,me,more,about,your,family,.],
  342.         [who,else,in,your,family,Z,?],
  343.         [your,M,?],
  344.         [what,else,comes,to,mind,when,you,think,of,your,M,?]],
  345.     [2,[_,your,Y],0,
  346.         [your,Y,?],
  347.         [why,do,you,say,your,Y,?],
  348.         [does,that,suggest,anything,else,which,belongs,to,you,?],
  349.         [is,it,important,to,you,that,your,Y,?]]]]).
  350.  
  351. rules([[memory,0],[
  352.     [1,[_,your,Y],0,
  353.         [lets,discuss,further,why,your,Y,.],
  354.         [earlier,you,said,your,Y,.],
  355.         [but,your,Y,?],
  356.         [does,that,have,anything,to,do,with,the,fact,that,your,Y,?]]]]).
  357.         
  358. rules([[can,0],[
  359.     [1,[_,can,i,Y],0,
  360.         [you,believe,'I',can,Y,',',do,you,not,?],
  361.         [equal,[what,0]],
  362.         [you,want,me,to,be,able,to,Y,?],
  363.         [perhaps,you,would,like,to,be,able,to,Y,yourself,?]],
  364.     [2,[_,can,you,Y],0,
  365.         [whether,or,not,you,can,Y,depends,on,you,more,than,on,me,.],
  366.         [do,you,want,to,be,able,to,Y,?],
  367.                 [perhaps,you,do,not,want,to,Y,.],
  368.         [equal,[what,0]]]]]).
  369.  
  370. rules([[what,0],[
  371.     [1,[_],0,
  372.         [why,do,you,ask,?],
  373.         [does,that,question,interest,you,?],
  374.         [what,is,it,you,really,want,to,know,?],
  375.         [are,such,questions,much,on,your,mind,?],
  376.         [what,answer,would,please,you,most,?],
  377.         [what,do,you,think,?],
  378.         [what,comes,to,your,mind,when,you,ask,that,?],
  379.         [have,you,asked,such,questions,before,?],
  380.         [have,you,asked,anyone,else,?]]]]).
  381.  
  382. rules([[because,0],[
  383.     [1,[_],0,
  384.         [is,that,the,real,reason,?],
  385.         [do,any,other,reasons,not,come,to,mind,?],
  386.         [does,that,reason,seem,to,explain,anything,else,?],
  387.         [what,other,reasons,might,there,be,?]]]]).
  388.  
  389. rules([[why,0],[
  390.     [1,[_,why,dont,i,Y],0,
  391.         [do,you,believe,'I',do,not,Y,?],
  392.         [perhaps,'I',will,Y,in,good,time,.],
  393.         [should,you,Y,yourself,?],
  394.                 [you,want,me,to,Y,?],
  395.         [equal,[what,0]]],
  396.     [2,[_,why,cant,you,Y],0,
  397.         [do,you,think,you,should,be,able,to,Y,?],
  398.         [do,you,want,to,be,able,to,Y,?],
  399.         [do,you,believe,this,will,help,you,to,Y,?],
  400.                 [have,you,any,idea,why,you,can,not,Y,?],
  401.         [equal,[what,0]]]]]).
  402.  
  403. rules([[everyone,2],[
  404.     [1,[_,[*,everyone,everybody,nobody,noone,M],_],0,
  405.         [really,',',M,?],
  406.         [surely,not,M,?],
  407.         [can,you,think,of,anyone,in,particular,?],
  408.         [who,',',for,example,?],
  409.         [you,are,thinking,of,a,very,special,person,?],
  410.         [who,',',may,i,ask,?],
  411.         [someone,special,perhaps,?],
  412.         [you,have,a,paticular,person,in,mind,',',do,you,not,?],
  413.         [who,do,you,think,you,are,talking,about,?]]]]).
  414.  
  415. rules([[always,1],[
  416.     [1,[_],0,
  417.         [can,you,think,of,a,specific,example,?],
  418.         [when,?],
  419.         [what,incident,are,you,thinking,of,?],
  420.         [really,',',always,?]]]]).
  421.  
  422. rules([[like,10],[
  423.         [1,[_,[*,im,youre,am,is,are,was,_],_,like,_],0,
  424.         [equal,[dit,10]]],
  425.     [2,[_],0,
  426.         [newkey]]]]).
  427.  
  428. rules([[dit,10],[
  429.     [1,[_],0,
  430.         [in,what,way,?],
  431.         [what,resemblance,do,you,see,?],
  432.         [what,does,that,similarity,suggest,to,you,?],
  433.         [what,other,connections,do,you,see,?],
  434.         [what,so,you,suppose,that,resemblance,means,?],
  435.         [what,is,the,connection,',',do,you,suppose,?],
  436.         [could,there,really,be,some,connection,?],
  437.         [how,?]]]]).
  438.  
  439. rules([[quit,100],[
  440.     [1,[_],0,
  441.         [goodbye,.,'My',secretary,will,send,you,a,bill,.]]]]).
  442.  
  443.  
  444. /*****************************************************************************/
  445. % char_type(+Char,?Type)
  446. %    Char is an ASCII code.
  447. %    Type is whitespace, punctuation, numeric, alphabetic, or special.
  448.  
  449. char_type(46,period) :- !.
  450. char_type(X,alphanumeric) :- X >= 65, X =< 90, !.
  451. char_type(X,alphanumeric) :- X >= 97, X =< 123, !.
  452. char_type(X,alphanumeric) :- X >= 48, X =< 57, !.
  453. char_type(X,whitespace) :- X =< 32, !.
  454. char_type(X,punctuation) :- X >= 33, X =< 47, !.
  455. char_type(X,punctuation) :- X >= 58, X =< 64, !.
  456. char_type(X,punctuation) :- X >= 91, X =< 96, !.
  457. char_type(X,punctuation) :- X >= 123, X =< 126, !.
  458. char_type(_,special).
  459.  
  460.  
  461. /*****************************************************************************/
  462. % lower_case(+C,?L)
  463. %   If ASCII code C is an upper-case letter, then L is the
  464. %   corresponding lower-case letter. Otherwise L=C.
  465.  
  466. lower_case(X,Y) :- 
  467.     X >= 65,
  468.     X =< 90,
  469.     Y is X + 32, !.
  470.  
  471. lower_case(X,X).
  472.                    
  473.  
  474. /*****************************************************************************/
  475. % read_lc_string(-String)
  476. %  Reads a line of input into String as a list of ASCII codes,
  477. %  with all capital letters changed to lower case.
  478.  
  479. read_lc_string(String) :-
  480.     get0(FirstChar),
  481.     lower_case(FirstChar,LChar),
  482.     read_lc_string_aux(LChar,String).
  483.  
  484. read_lc_string_aux(31,[]) :- !.  % end of line
  485.  
  486. read_lc_string_aux(26,[]) :- !.  % end of file
  487.  
  488. %read_lc_string_aux(10,[]) :- !.  % end of line
  489.  
  490. %read_lc_string_aux(-1,[]) :- !.  % end of file
  491.  
  492. read_lc_string_aux(LChar,[LChar|Rest]) :- read_lc_string(Rest).
  493.  
  494.  
  495. /*****************************************************************************/
  496. % extract_word(+String,-Rest,-Word) (final version)
  497. %  Extracts the first Word from String; Rest is rest of String.
  498. %  A word is a series of contiguous letters, or a series
  499. %  of contiguous digits, or a single special character.
  500. %  Assumes String does not begin with whitespace.
  501.  
  502. extract_word([C|Chars],Rest,[C|RestOfWord]) :-
  503.     char_type(C,Type),
  504.     extract_word_aux(Type,Chars,Rest,RestOfWord).
  505.  
  506. extract_word_aux(special,Rest,Rest,[]) :- !.
  507.    % if Char is special, don't read more chars.
  508.  
  509. extract_word_aux(Type,[C|Chars],Rest,[C|RestOfWord]) :-
  510.     char_type(C,Type), !,
  511.     extract_word_aux(Type,Chars,Rest,RestOfWord).
  512.  
  513. extract_word_aux(_,Rest,Rest,[]).   % if previous clause did not succeed.
  514.  
  515.  
  516. /*****************************************************************************/
  517. % remove_initial_blanks(+X,?Y)
  518. %   Removes whitespace characters from the
  519. %   beginning of string X, giving string Y.
  520.  
  521. remove_initial_blanks([C|Chars],Result) :-
  522.     char_type(C,whitespace), !,
  523.     remove_initial_blanks(Chars,Result).
  524.  
  525. remove_initial_blanks(X,X).   % if previous clause did not succeed.
  526.  
  527.  
  528. /*****************************************************************************/
  529. % digit_value(?D,?V)
  530. %  Where D is the ASCII code of a digit,
  531. %  V is the corresponding number.
  532.  
  533. digit_value(48,0).
  534. digit_value(49,1).
  535. digit_value(50,2).
  536. digit_value(51,3).
  537. digit_value(52,4).
  538. digit_value(53,5).
  539. digit_value(54,6).
  540. digit_value(55,7).
  541. digit_value(56,8).
  542. digit_value(57,9).
  543.  
  544.  
  545. /*****************************************************************************/
  546. % string_to_number(+S,-N)
  547. %  Converts string S to the number that it
  548. %  represents, e.g., "234" to 234.
  549. %  Fails if S does not represent a nonnegative integer.
  550.  
  551. string_to_number(S,N) :-
  552.     string_to_number_aux(S,0,N).
  553.  
  554. string_to_number_aux([D|Digits],ValueSoFar,Result) :-
  555.     digit_value(D,V),
  556.     NewValueSoFar is 10*ValueSoFar + V,
  557.     string_to_number_aux(Digits,NewValueSoFar,Result).
  558.  
  559. string_to_number_aux([],Result,Result).
  560.  
  561.  
  562. /*****************************************************************************/
  563. % string_to_atomic(+String,-Atomic)
  564. %  Converts String into the atom or number of
  565. %  which it is the written representation.
  566.  
  567. string_to_atomic([C|Chars],Number) :-
  568.     string_to_number([C|Chars],Number), !.
  569.  
  570. string_to_atomic(String,Atom) :- name(Atom,String).
  571.   % assuming previous clause failed.
  572.  
  573.  
  574. /*****************************************************************************/
  575. % extract_atomics(+String,-ListOfAtomics) (second version)
  576. %  Breaks String up into ListOfAtomics
  577. %  e.g., " abc def  123 " into [abc,def,123].
  578.  
  579. extract_atomics(String,ListOfAtomics) :-
  580.     remove_initial_blanks(String,NewString),
  581.     extract_atomics_aux(NewString,ListOfAtomics).
  582.  
  583. extract_atomics_aux([C|Chars],[A|Atomics]) :-
  584.     extract_word([C|Chars],Rest,Word),
  585.     string_to_atomic(Word,A),       % <- this is the only change
  586.     extract_atomics(Rest,Atomics).
  587.  
  588. extract_atomics_aux([],[]).
  589.  
  590.  
  591. /*****************************************************************************/
  592. % clean_string(+String,-Cleanstring)
  593. %  removes all punctuation characters from String and return Cleanstring
  594.  
  595. clean_string([C|Chars],L) :- 
  596.     char_type(C,punctuation),
  597.     clean_string(Chars,L), !.
  598. clean_string([C|Chars],[C|L]) :-
  599.     clean_string(Chars,L), !.
  600. clean_string([C|[]],[]) :-
  601.     char_type(C,punctuation), !.
  602. clean_string([C|[]],[C]).
  603.  
  604.  
  605. /*****************************************************************************/
  606. % read_atomics(-ListOfAtomics)
  607. %  Reads a line of input, removes all punctuation characters, and converts
  608. %  it into a list of atomic terms, e.g., [this,is,an,example].
  609.  
  610. read_atomics(ListOfAtomics) :-
  611.     read_lc_string(String),
  612.     clean_string(String,Cleanstring),
  613.     extract_atomics(Cleanstring,ListOfAtomics).
  614.  
  615.  
  616. /****************************************************************************/
  617. % isalist(+List)
  618. %    checks if List is actually a list
  619.  
  620. isalist([_|_]).
  621.  
  622.  
  623. /****************************************************************************/
  624. % member(?Element,+List)
  625. %    checks if Element is in List
  626.  
  627. member(X,[X|_]).
  628. member(X,[_|T]) :- member(X,T).
  629.  
  630.  
  631. /****************************************************************************/
  632. % append(?List1, ?List2, ?List3)
  633. %    appends List2 on the end of List1 and returns it as List3
  634.  
  635. append([],L,L).
  636. append([X|L1],L2,[X|L3]) :- append(L1,L2,L3).
  637.  
  638.  
  639. /****************************************************************************/
  640. % flatten(+List,-FlatList)
  641. %    flattens List with sublists into FlatList
  642.  
  643. flatten([],[]).
  644. flatten([H|T],[H|T2]) :- \+ isalist(H),
  645.                          flatten(T,T2).
  646. flatten([H|T],L) :- isalist(H),
  647.                     flatten(H,A),
  648.                     flatten(T,B),
  649.                     append(A,B,L).
  650.  
  651.  
  652. /****************************************************************************/
  653. % last_member(-Last,+List)
  654. %    returns the last element of List in Last
  655.  
  656. last_member(End,List) :- append(_,[End],List).
  657.  
  658.  
  659. /****************************************************************************/
  660. % findnth(+List,+Number,-Element)
  661. %    returns the Nth member of List in Element
  662.  
  663. findnth([E|_],1,E).
  664. findnth([_|T],N,T1) :- V is N - 1,
  665.                        findnth(T,V,T1).
  666.  
  667.  
  668. /****************************************************************************/
  669. % replace(+Element1,+List1,+Element2,-List2)
  670. %    replaces all instances of Element1 in List1 with Element2 and returns
  671. %       the new list as List2
  672. %    does not replace variables in List1 with Element1
  673.  
  674. replace(_,[],_,[]).
  675. replace(X,[H|T],A,[A|T2]) :- nonvar(H), H = X, !, replace(X,T,A,T2).
  676. replace(X,[H|T],A,[H|T2]) :- replace(X,T,A,T2).
  677.  
  678.  
  679. /****************************************************************************/
  680. % simplify(+List,-Result)
  681. %   implements non-overlapping simplification
  682. %   simplifies List into Result
  683.  
  684. simplify(List,Result) :- sr(List,Result,X,Y), !,
  685.              simplify(X,Y).
  686. simplify([W|Words],[W|NewWords]) :- simplify(Words,NewWords).
  687. simplify([],[]).
  688.  
  689.  
  690. /****************************************************************************/
  691. % match(+MatchRule,+InputList)
  692. %    matches the MatchRule with the InputList. If they match, the variables
  693. %    in the MatchRule are instantiated to one of three things:
  694. %       an empty list
  695. %       a single word
  696. %       a list of words
  697.  
  698. match(A,C) :- match_aux1(A,C),!.
  699. match(A,C) :- match_aux2(A,C).
  700.  
  701. match_aux1(A,C) :-
  702.     member([*|T],A),
  703.     nonvar(T),
  704.     member(Tm,T),
  705.     nonvar(Tm),
  706.     replace([*|T],A,Tm,B),
  707.     match_aux2(B,C),
  708.     !, last_member(L,T), L = Tm.
  709.  
  710. match_aux2([],[]).
  711. match_aux2([Item|Items],[Word|Words]) :-
  712.     match_aux3(Item,Items,Word,Words),!.
  713. match_aux2([Item1,Item2|Items],[Word|Words]) :-
  714.     var(Item1),
  715.     nonvar(Item2),
  716.     Item2 == Word,!,
  717.     match_aux2([Item1,Item2|Items],[[],Word|Words]).
  718. match_aux2([Item1,Item2|Items],[Word|Words]) :-
  719.     var(Item1),
  720.     var(Item2),!,
  721.     match_aux2([Item1,Item2|Items],[[],Word|Words]).
  722. match_aux2([[]],[]).
  723.  
  724. match_aux3(Word,Items,Word,Words) :-
  725.     match_aux2(Items,Words), !.
  726. match_aux3([Word|Seg],Items,Word,Words0) :-
  727.     append(Seg,Words1,Words0),
  728.     match_aux2(Items,Words1).
  729.  
  730.  
  731. /****************************************************************************/
  732. % makecomment(+KeyWordList,+InputList,-Comment)
  733. %    returns ELIZA's Comment to the InputList based on the KeyWordList
  734. %    takes care of special keywords 'your', and 'memory', which require
  735. %       additional processing before a comment can be generated
  736.  
  737. makecomment([[your,2]|T],InputList,Comment) :-
  738.     assertz(mem(InputList)),
  739.     rules([[your,2],Reassembly]),
  740.     mc_aux([[your,2]|T],Reassembly,InputList,Comment),!.
  741. makecomment([[memory,0]|T],_,Comment) :-
  742.     retract(mem(I2)),
  743.     %retractall(mem(I2)),
  744.     abolish(mem,1),
  745.     rules([[memory,0],Reassembly]),
  746.     mc_aux([[memory,0]|T],Reassembly,I2,Comment),!.
  747. makecomment([[memory,0]|T],InputList,Comment) :-
  748.     \+ retract(mem(_)),!,
  749.     makecomment(T,InputList,Comment).
  750. makecomment([Keyword|T],InputList,Comment) :-
  751.     rules([Keyword,Reassembly]),
  752.     mc_aux([Keyword|T],Reassembly,InputList,Comment),!.
  753. makecomment([_|T],InputList,Comment) :-
  754.     makecomment(T,InputList,Comment),!.
  755.  
  756.  
  757. mc_aux(KeyWordList,[[DRuleNum,MatchRule,N|T]|_],InputList,Comment) :-
  758.     match(MatchRule,InputList),
  759.     mc_aux2(KeyWordList,DRuleNum,N,T,InputList,Comment),!.
  760. mc_aux(KeyWordList,[_|T],InputList,Comment) :-
  761.     mc_aux(KeyWordList,T,InputList,Comment).
  762. mc_aux(_,[],_,_) :- !,fail.
  763.  
  764. mc_aux2(KeyWordList,DRuleNum,N,T,InputList,Comment) :-
  765.     length(T,TLen),
  766.     N < TLen, !,
  767.     NewN is N + 1,
  768.     findnth(T,NewN,Mn),
  769.     mc_aux3(KeyWordList,DRuleNum,N,NewN,Mn,InputList,Comment).
  770. mc_aux2(KeyWordList,DRuleNum,N,T,InputList,Comment) :-
  771.     member(Mn,T),
  772.     mc_aux3(KeyWordList,DRuleNum,N,0,Mn,InputList,Comment).
  773.  
  774.  
  775. mc_aux3([Keyword|T],DRuleNum,N,NewN,[equal,MnT],InputList,Comment) :-
  776.     !,
  777.     updaterule(Keyword,DRuleNum,N,NewN),
  778.     makecomment([MnT|T],InputList,Comment).
  779. mc_aux3([Keyword|T],DRuleNum,N,NewN,[newkey],InputList,Comment) :-
  780.     !,
  781.     updaterule(Keyword,DRuleNum,N,NewN),
  782.     makecomment(T,InputList,Comment).
  783. mc_aux3([Keyword|_],DRuleNum,N,NewN,Mn,_,Mn) :-
  784.     updaterule(Keyword,DRuleNum,N,NewN).
  785.  
  786.  
  787. /****************************************************************************/
  788. % process_input(+Input_List,+[],?Output)
  789. %     returns part of input after a comma, or
  790. %             part of input before a period
  791.  
  792. process_input([],L,L).
  793. process_input(['.'|_],L,L) :- findkeywords(L,K), length(K,Kl), Kl >= 3,!.
  794. process_input(['.'|T],_,L) :- !, process_input(T,[],L).
  795. process_input([','|_],L,L) :- findkeywords(L,K), length(K,Kl), Kl >= 3,!.
  796. process_input([','|T],_,L) :- !, process_input(T,[],L).
  797. process_input([H|T],S,L) :- append(S,[H],S2), process_input(T,S2,L).
  798.  
  799.  
  800. /****************************************************************************/
  801. % findkeywords(+InputList,?KeyWordList)
  802. %    returns a list with the keywords in the input list
  803. %    if no keywords are found returns a list with keywords 'memory' and 'none'
  804.  
  805. findkeywords([],[[memory,0],[none,0]]).
  806. findkeywords([H|T],[[H,I]|T1]) :- rules([[H,I]|_]), !, findkeywords(T,T1).
  807. findkeywords([_|T],T1) :- findkeywords(T,T1).
  808.  
  809.  
  810. /****************************************************************************/
  811. % sortkeywords(+KeyWordList,?SortedList)
  812. %    returns a list with the keywords sorted according to their importance
  813. %    this routine implements a simple bubble sort, customized for this
  814. %    application
  815.  
  816. sortkeywords(X,Y) :- sort_aux(X,A,1), !, sortkeywords(A,Y).
  817. sortkeywords(X,Y) :- sort_aux(X,Y,_).
  818.  
  819. sort_aux([],[],0).
  820. sort_aux([X],[X],0).
  821. sort_aux([[A,X],[B,Y]|T],[[B,Y],[A,X]|T],1) :- X < Y.
  822. sort_aux([X,Y|T],[X|T2],S) :- sort_aux([Y|T],T2,S).
  823.  
  824.  
  825. /****************************************************************************/
  826. % updaterule(+KeyList,+DRuleNum,+N,+NewN)
  827. %    updates a rule by changing the number of the reassembly rule associated
  828. %       with a decomposition rule. The main rule to modify is indicated by
  829. %       KeyList. The decomposition rule within the main rule is indicated by
  830. %       DRuleNum. N is the previous reassembly rule used. NewN is the new
  831. %       one used. N is updated to NewN so that next time a different reassembly
  832. %       (actually the next in sequence) in used.
  833.  
  834. updaterule(KeyList,DRuleNum,N,NewN) :-
  835.     retract(rules([KeyList,Rt])),
  836.     replace([DRuleNum,A,N|T],Rt,[DRuleNum,A,NewN|T],Rt2),
  837.     assertz(rules([KeyList,Rt2])).
  838.  
  839.  
  840. /****************************************************************************/
  841. % writecomment(+CommentList)
  842. %    prints the elements of CommentList. First Characater of first element is
  843. %       converted to uppercase befor printing
  844.  
  845. writecomment([]).
  846. writecomment(['I'|T]) :- !, write('I'), writecomment_aux(T).
  847. writecomment([H|T]) :- !,
  848.     name(H,[C|L]),
  849.     D is C - 32,
  850.         name(Z,[D|L]),
  851.     write(Z),
  852.     writecomment_aux(T).
  853.  
  854. writecomment_aux([]).
  855. writecomment_aux([H|T]) :- 
  856.     name(H,[C]),
  857.     char_type(C,punctuation), !,
  858.     write(H),
  859.     writecomment_aux(T).
  860. writecomment_aux([H|T]) :- 
  861.     write(' '),
  862.     write(H),
  863.     writecomment_aux(T).
  864.  
  865.  
  866. /****************************************************************************/
  867. % quittime(+InputList)
  868. %    checks if the atom 'quit' is in the InputList
  869.  
  870. quittime(X) :- member('quit',X).
  871.  
  872.  
  873. /****************************************************************************/
  874. % eliza
  875. %    main routine of ELIZA
  876.  
  877. eliza :-
  878. %    reconsult('eliza.rls'),
  879.     %retractall(mem(_)),nl,nl,
  880. abolish(mem,1),nl,nl,
  881.         write('Hello. I am ELIZA. How can I help you?'),nl,write('> '),
  882.     repeat,
  883.        read_atomics(Input),nl,
  884.            process_input(Input,[],Input2),
  885.            simplify(Input2,Input3),
  886.            findkeywords(Input3,KeyWords),
  887.            sortkeywords(KeyWords,KeyWords2),
  888.            makecomment(KeyWords2,Input3,Comment),
  889.            flatten(Comment,Comment2),
  890.            writecomment(Comment2),nl,write('> '),
  891.            quittime(Input3),
  892.            !.
  893.  
  894.  
  895. %:- see(user),eliza,nl,nl.
  896.